perm filename MAKNUM.FAI[XX,LCS]1 blob
sn#207691 filedate 1976-03-25 generic text, type T, neo UTF8
00010 TITLE MAKNUM
00055 ENTRY MAKNUM
00077 EXTERNAL ITMSUB,ALPHA,IFIX,NOZERO,.COMM.,STF,FLOAT,AMOD,CENTX,SLUR
00100 MAKNUM: 0 ; SUBROUTINE MAKNUM(RNUM)
00400 ;100 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
00600 ;200 EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
00700 ;300 1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
00800 ;400 1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
00900 ;500 1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
01100 ;600 DATA RS/10.0/,RBX/1.0/
01200 MOVE 11,@(16)
01300 ;700 RB8=R8
01400 MOVE 02,.COMM.+=9
01500 MOVEM 02,RB8#
01800 MOVE 02,.COMM.+=24 ; J3X=J3
01900 MOVEM 02,J3X# ; P7=0=BDR40; =1=BDI40; =2=PRIM.
02400 JSA 16,NOZERO ; CALL NOZERO(R6)
02500 JUMP .COMM.+7
02800 MOVE 02,.COMM.+7 ; R5=R6
02900 MOVEM 02,.COMM.+6 ; UPPER CASE - BDR40
03400 MOVSI 02,206620 ; R6=48000000.0+(R7+50.)*10000.
03500 FADR 02,.COMM.+=8
03600 FMPR 02,[10000.0]
03700 FADR 02,[48000000.0]
04100 MOVEM 02,.COMM.+7
04400 MOVE 02,[99999999.0] ; R7=99999999.0
04500 MOVEM 02,.COMM.+=8
04700 ; 32500 C BLANKS
05300 ; 32700 IF(RNUM.NE.9999.)GO TO 2
05500 CAME 11,[9999.0]
05600 JRST MN2
05800 ; 32800 C NEXT FOR 'C'OMMON TIME
06000 ; 32900 RNUM=12.
06100 MOVSI 11,204600
06400 ; 33000 C MAKES A 'C'
06600 ; 33100 R4=R4-2.2
06700 MOVN 02,[2.2]
06800 FADRM 02,.COMM.+5
07000 ; 33200 C .2 FOR BAD POS. OF LETTERS
07200 ; 33300 GO TO 4
07300 JRST MN4
07700 ; 33500 2 ONE=0
07800 MN2: SETZM ONE#
08000 ; 33600 RNUM=IFIX(RNUM)
08100 JSA 16,IFIX
08200 JUMP 11
08300 MOVEM 11
08400 JSA 16,FLOAT
08500 JUMP 11
08600 MOVEM 11
08800 ; 33700 C SO MISTAKES (I.E. 2.2) WON'T BREAK THE PROG.
09000 ; 33800 IF(RNUM.EQ.1.)ONE=3.
09400 MOVSI 02,201400
09500 CAME 02,11
09600 JRST .+3
09700 MOVSI 02,202600
09800 MOVEM 02,ONE
10100 ; 33900 IF(RNUM.GT.9.)GO TO 3
10200 MOVSI 02,204440
10300 CAMGE 02,11
10400 JRST MN3
10600 ; 34000 C JUMP FOR 2 OR 3 DIGIT NUMBER
10800 ; 34100 4 R6=R6+RNUM*100.+47.
10900 MN4: MOVSI 02,206570
11100 MOVSI 03,207620
11200 FMPR 03,11
11300 FADR 02,3
11400 FADRM 02,.COMM.+7
11600 ; 34200 C PUTS BLANK ON END (.47)
11800 ; 34300 GO TO 1
11900 JRST MN1
12300 ; 34500 3 RJY=10.
12400 MN3: MOVSI 02,204500
12500 MOVEM 02,RJY#
12700 ; 34600 IF(RNUM.GE.100.)RJY=100.
12800 MOVSI 02,207620
12900 CAMLE 02,11
13000 JRST .+3
13100 MOVSI 02,207620
13200 MOVEM 02,RJY
13500 ; 34700 B=IFIX(RNUM/RJY)
13600 MOVE 02,11
13700 FDVR 02,RJY
13800 MOVEM 02,B#
13900 JSA 16,IFIX
14000 JUMP B#
14100 MOVEM B#
14200 JSA 16,FLOAT
14300 JUMP B#
14700 MOVEM B
14900 ; 34800 C=AMOD(RNUM,RJY)
15000 JSA 16,AMOD
15100 JUMP 11
15200 JUMP RJY
15300 MOVEM C#
15500 ; 34900 IF(RNUM.LT.100)GO TO 7
15600 MOVSI 02,207620
15700 CAMLE 02,11
15800 JRST MN7
16000 ; 35000 D=IFIX(C/10.)
16100 MOVE 02,C
16200 FDVR 02,[10.0]
16300 MOVEM 02,D#
16400 JSA 16,IFIX
16500 JUMP D
16600 MOVEM D
16700 JSA 16,FLOAT
16800 JUMP D
16900 MOVEM D
17100 ; 35100 C=AMOD(C,10.)
17200 JSA 16,AMOD
17300 JUMP C
17400 JUMP [10.0]
17500 MOVEM C
17700 ; 35200 IF(C.EQ.1.)ONE=ONE+3.
17800 MOVSI 3,201400
17900 CAME 3,C
18000 JRST .+3
18100 MOVSI 02,202600
18200 FADRM 02,ONE
18500 ; 35300 R7=C*1000000.+999999.0
18600 MOVE 02,[1000000.0]
18700 FMPR 02,C
18800 FADR 02,[999999.0]
18900 MOVEM 02,.COMM.+=8
19100 ; 35400 C=D
19200 MOVE 02,D
19300 MOVEM 02,C
19500 ; 35500 7 R6=R6+B*100.+C
19600 MN7: MOVE 02,.COMM.+7
20000 FADR 02,C
20100 MOVSI 03,207620
20200 FMPR 03,B
20300 FADR 02,3
20400 MOVEM 02,.COMM.+7
20600 ; 35600 IF(B.EQ.1.)ONE=ONE+3.
20700 MOVSI 02,201400
20800 CAME 02,B
20900 JRST .+3
21000 MOVSI 02,202600
21100 FADRM 02,ONE
21400 ; 35700 IF(C.EQ.1.)ONE=ONE+3.
21500 MOVSI 02,201400
21600 CAME 02,C
21700 JRST .+3
21800 MOVSI 02,202600
21900 FADRM 02,ONE
22200 ; 35800 B=R5
22300 MOVE 02,.COMM.+6
22400 MOVEM 02,B
22600 ; 35900 IF(RNUM.GE.100.)B=B*2
22700 MOVSI 02,207620
22800 CAMLE 02,11
22900 JRST .+3
23000 MOVSI 02,202400
23100 FMPRM 02,B
23400 ; 36000 J3=J3-RS*RSTJ2*B
23500 MOVE 02,[10.0]
23600 FMPR 02,STF+=8
23700 FMPR 02,B
23800 JSA 16,FLOAT
23900 JUMP .COMM.+=24
24000 FSBR 2
24100 MOVEM 3
24200 JSA 16,IFIX
24300 JUMP 3
24400 MOVEM .COMM.+=24
24600 ; 36100 C FOR 2 DIGIT NUMBER
25900 ; 36600 C ADJUSTS FOR 11, ETC.
26500 ; 36900 1 J3=J3+ONE*R5*RSTJ2
26600 MN1: MOVE 02,.COMM.+6
26700 FMPR 02,ONE
26800 FMPR 02,STF+=8
26900 JSA 16,FLOAT
27000 JUMP .COMM.+=24
27100 FADR 2
27200 MOVE 3,
27300 JSA 16,IFIX
27400 JUMP 3
27500 MOVEM .COMM.+=24
27700 ; 37000 C CENTERS THE NUMBER '1'
27900 ; 37100 CALL ALPHA
28000 JSA 16,ALPHA
28200 ; 37200 J3=J3X
28300 MOVE 02,J3X#
28400 MOVEM 02,.COMM.+=24
28600 ; 37300 IF(RB8.EQ.0)RETURN
28900 SKIPN RB8
29000 JRA 16,1(16)
29200 ; 37400 C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
29500 JSA 16,FLOAT ;37500 R3=J3-R5
29600 JUMP .COMM.+=24
29700 FSBR .COMM.+6
29800 MOVEM .COMM.+4
30100 SKIPE .COMM.+=31 ;37600 IF(J10.EQ.0)J10=1
30500 JRST .+3
30600 MOVEI 02,1
30700 MOVEM 02,.COMM.+=31 ;USE J10 FOR EVEN THICKER BOX AND CIRC.
31200 ; 37800 IF(RNUM.GT.9)R3=R3+R5*RBX
31300 MOVSI 02,204440
31400 CAML 02,11
31500 JRST .+4
31600 MOVSI 02,201400
31700 FMPR 02,.COMM.+6
31800 FADRM 02,.COMM.+4
32100 ; 37900 C TO SET CENTER IF(RB8.EQ.2)GO TO 5
32400 MOVSI 02,202400
32500 CAMN 02,RB8
32600 JRST MN5
33200 MOVE 02,[0.05] ;38100 R4=R4+R5+.1+.05/R5
33300 FDVR 02,.COMM.+6
33350 FADR 2,[0.1]
33400 FADR 02,.COMM.+6
33500 FADRM 02,.COMM.+5
33700 ; 38200 C END OF ABOVE IS FOR SMALL CIRCLES.
34000 MOVSI 02,203440 ;38300 B=4.5
34100 MOVEM 02,B
34300 ; 38400 IF(RNUM.GE.100.)B=5.5
34400 MOVSI 02,207620
34500 CAMLE 02,11
34600 JRST .+3
34700 MOVSI 02,203540
34800 MOVEM 02,B
35100 ; 38500 R5=R5*B
35200 MOVE 02,B
35300 FMPRM 02,.COMM.+6
35500 ; 38600 JA=12
35900 MOVEI 02,11
36000 MOVEM 02,.COMM.+1
36200 ; 38700 J6=0
36300 SETZM .COMM.+=27
36500 ; 38800 J7=0
36600 SETZM .COMM.+=28
36800 ; 38900 J8=J10
36900 MOVE 02,.COMM.+=31
37000 MOVEM 02,.COMM.+=29 ;39000 CALL CENTX
37300 JSA 16,CENTX
37600 JSA 16,SLUR ;39100 CALL SLUR
37800 JRA 16,1(16) ;39200 RETURN
38300 ; 39400 5 JA=4
38400 MN5: MOVEI 02,4
38500 MOVEM 02,.COMM.+1
38700 ; 39500 B=6
38800 MOVSI 02,203600
38900 MOVEM 02,B
39100 ; 39600 R9=0
39200 SETZM .COMM.+=10
39400 ; 39700 IF(RNUM.LT.100.)GO TO 8
39500 MOVSI 02,207620
39600 CAMLE 02,11
39700 JRST MN8
39900 ; 39800 B=9.
40000 MOVSI 02,204440
40100 MOVEM 02,B
40300 ; 39900 R9=R5*6.
40400 MOVSI 02,203600
40500 FMPR 02,.COMM.+6
40600 MOVEM 02,.COMM.+=10
40800 ; 40000 C MAKES RECTANGLE IF ↑100
41300 ; 40100 8 R4=R4+R5*.7+.1
41600 MN8: MOVE 03,[0.7]
41700 FMPR 03,.COMM.+6
41750 FADR 3,[0.1]
41800 FADRM 3,.COMM.+5
42100 ; 40200 R8=R5*B
42200 MOVE 02,.COMM.+6
42300 FMPR 02,B
42400 MOVEM 02,.COMM.+=9
42600 ; 40300 J5=50
42700 MOVEI 02,62
42800 MOVEM 02,.COMM.+=26
43000 ; 40400 CALL ITMSUB
43100 JSA 16,ITMSUB
43300 ; 40500 C RETURNS ORIG. HORIZ. POS.
43500 JRA 16,1(16) ;40600 END
43600 END